#!/usr/bin/perl -w

# this is a very simple script that transforms the functions database from the misterious 822 format
# to our beloved XML

use desc::822;

open(LOG, ">>", $ARGV[1]);

%typechars=(
    'G' => 'gen',
    'n' => 'variable-number',
    'S' => 'variable-entree',
    'V' => 'local-variable-entree',
    'L' => 'long',
    'r' => 'chars-unparsed',
    's' => 'chars-parsed',
    'I' => 'expression-inline',
    'E' => 'expression-eval',
    's*'=> 'string',
    '&' => 'reference',
    'p' => 'precision-real',
    'P' => 'precision-series',
    'M' => 'unknown-type'
);
%defaults=(
    'G' => 'NULL',
    'n' => '-1',
    '&' => 'NULL',
    'V' => 'NULL',
    'I' => 'NULL'
);

sub xmlify {
    my($input) = @_;
    $input =~ s/</&gt;/g;
    $input =~ s/>/&lt;/g;
    $input =~ s/&/&amp;/g;
    return $input;
}    

print <<EOF;
<?xml version="1.0"?>
<!-- This file is autogenerated from the database. -->
<!-- See src/gen_xml -->
<!-- Do not edit. All changes will be lost -->

<pari-functions>
EOF

PARI::822::read(\%funcs,$ARGV[0]);

foreach my $name (sort keys %funcs)
{
    my %func=%{$funcs{$name}};
    my $class = $func{'Class'};
    my $gpname=$func{'Function'};
    my $section=$func{'Section'};
    my $proto=$func{'Prototype'};
    my $cname=$func{'C-Name'};
    my $help=$func{'Help'};
    my $desc=$func{'Description'};
    $name = &xmlify($name);
    print <<EOF;
    <function name="$name">
EOF
    if(defined($class)) {
        print <<EOF;
        <class>$class</class>
EOF
    }
    if(defined($section)) {
        print <<EOF;
        <section>$section</section>
EOF
    }
    if(defined($gpname)) {
        $gpname = &xmlify($gpname);
        print <<EOF;
        <gpname>$gpname</gpname>
EOF
    }
    if(defined($cname)) {
        print <<EOF;
        <cname>$cname</cname>
EOF
    }
    if(defined($desc)) {
        $desc = &xmlify($desc);
        print <<EOF;
        <description>$desc</description>
EOF
    }
    if(defined($help)) {
        $help = &xmlify($help);
        print <<EOF;
        <help>$help</help>
EOF
    }
    if(defined($proto)) {
        print <<EOF;
        <prototype>
EOF
        my $return_type="gen";
        if (substr($proto,0,1) eq "v") {
            $return_type="void";
            $proto = substr($proto, 1);
        } elsif (substr($proto,0,1) eq "i") {
            $return_type="int";
            $proto = substr($proto, 1);
        } elsif (substr($proto,0,1) eq "l") {
            $return_type="long";
            $proto = substr($proto, 1);
        }
        print <<EOF;
            <return>$return_type</return>
EOF
        my @protochars=split(/(DG|D\&|DI|DV|Dn|D.*?\,.\,|s\*|D.|.)/, $proto);
        my $defaultargs_on;
        my @varargs=();
        for my $letter (@protochars)
        {
            next if not $letter;
            next if $letter eq "=";
            my $typechar = chop($letter);
            if ($typechar eq ",") {$typechar = chop($letter);}
            if ($typechar eq "*") {$typechar = chop($letter) . $typechar;}
            $type=$typechars{$typechar};
            defined($type) or die("Unknown character $typechar in prototype\
            $proto of function $name");
            print <<EOF;
            <param>
                <type>$type</type>
EOF
            if ($letter eq "D") {
                my $default = $defaults{$typechar};
                defined($default) or die("Unknown character $letter in prototype\
                $proto of function $name");
                print <<EOF;
                <default>$default</default>
EOF
            } elsif (substr($letter, 0, 1) eq "D") {
                my $defaultval=substr($letter, 1, length($letter)-2);
                print <<EOF;
                <default>$defaultval</default>
EOF
            } elsif ( $letter ne "" ) {
                die("Unknown character $letter in prototype $proto of\
                function $gpname");
            }
                print <<EOF;
            </param>
EOF
        }
        print <<EOF;
        </prototype>
EOF
    }
    print <<EOF;
    </function>
EOF
}
print <<EOF;
</pari-functions>
EOF
close(LOG);
